home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / ole / ole2bm / ole2bm.frm < prev    next >
Text File  |  1994-05-06  |  6KB  |  196 lines
  1. VERSION 2.00
  2. Begin Form frmDemo 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "OLE 2.0 To Bitmap Demo"
  6.    ClientHeight    =   3915
  7.    ClientLeft      =   1095
  8.    ClientTop       =   1470
  9.    ClientWidth     =   6315
  10.    Height          =   4320
  11.    Left            =   1035
  12.    MaxButton       =   0   'False
  13.    ScaleHeight     =   3915
  14.    ScaleWidth      =   6315
  15.    Top             =   1125
  16.    Width           =   6435
  17.    Begin CommandButton cmdEdit 
  18.       Caption         =   "&Edit Picture Box Bitmap"
  19.       Default         =   -1  'True
  20.       FontBold        =   -1  'True
  21.       FontItalic      =   0   'False
  22.       FontName        =   "MS Sans Serif"
  23.       FontSize        =   9.75
  24.       FontStrikethru  =   0   'False
  25.       FontUnderline   =   0   'False
  26.       Height          =   435
  27.       Left            =   0
  28.       TabIndex        =   0
  29.       Top             =   3480
  30.       Width           =   3195
  31.    End
  32.    Begin OLE olePbrush 
  33.       AutoActivate    =   0  'Manual
  34.       Class           =   "PBrush"
  35.       fFFHk           =   -1  'True
  36.       Height          =   2955
  37.       Left            =   3240
  38.       OleObjectBlob   =   OLE2BM.FRX:0000
  39.       OLETypeAllowed  =   1  'Embedded
  40.       TabIndex        =   3
  41.       Top             =   120
  42.       Width           =   2955
  43.    End
  44.    Begin PictureBox picBitmap 
  45.       AutoRedraw      =   -1  'True
  46.       DrawStyle       =   6  'Inside Solid
  47.       DrawWidth       =   12
  48.       FontBold        =   -1  'True
  49.       FontItalic      =   0   'False
  50.       FontName        =   "MS Sans Serif"
  51.       FontSize        =   30
  52.       FontStrikethru  =   0   'False
  53.       FontUnderline   =   0   'False
  54.       Height          =   2955
  55.       Left            =   120
  56.       ScaleHeight     =   195
  57.       ScaleMode       =   3  'Pixel
  58.       ScaleWidth      =   195
  59.       TabIndex        =   2
  60.       Top             =   120
  61.       Width           =   2955
  62.    End
  63.    Begin CommandButton cmdQuit 
  64.       Cancel          =   -1  'True
  65.       Caption         =   "&Quit"
  66.       FontBold        =   -1  'True
  67.       FontItalic      =   0   'False
  68.       FontName        =   "MS Sans Serif"
  69.       FontSize        =   9.75
  70.       FontStrikethru  =   0   'False
  71.       FontUnderline   =   0   'False
  72.       Height          =   435
  73.       Left            =   3180
  74.       TabIndex        =   1
  75.       Top             =   3480
  76.       Width           =   3135
  77.    End
  78.    Begin Label lblImage 
  79.       BackStyle       =   0  'Transparent
  80.       Caption         =   "OLE 2.0 PaintBrush Object"
  81.       Height          =   315
  82.       Index           =   1
  83.       Left            =   3240
  84.       TabIndex        =   5
  85.       Top             =   3120
  86.       Width           =   2955
  87.    End
  88.    Begin Label lblImage 
  89.       BackStyle       =   0  'Transparent
  90.       Caption         =   "VB Picture Box Bitmap"
  91.       Height          =   315
  92.       Index           =   0
  93.       Left            =   120
  94.       TabIndex        =   4
  95.       Top             =   3120
  96.       Width           =   2955
  97.    End
  98. End
  99. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  100. ' OLE2BM.FRM
  101. '____________________________________________________________________________
  102. Option Explicit
  103. DefInt A-Z
  104.  
  105. Dim PictureStale
  106.  
  107. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  108. ' Embed bitmap in OLE 2.0 object and open PaintBrush to edit it.
  109. '____________________________________________________________________________
  110. Sub cmdEdit_Click ()
  111.  
  112.     Pic2Ole picBitmap, olePbrush
  113.     PictureStale = True
  114.     olePbrush.Action = OLE_ACTIVATE
  115.  
  116. End Sub
  117.  
  118. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  119. ' Quit the program.
  120. '____________________________________________________________________________
  121. Sub cmdQuit_Click ()
  122.  
  123.     End
  124.  
  125. End Sub
  126.  
  127. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  128. ' Make sure the picture box gets painted on loading.
  129. '____________________________________________________________________________
  130. Sub Form_Paint ()
  131.  
  132.     picBitmap_Paint
  133.  
  134. End Sub
  135.  
  136. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  137. ' Embed bitmap in OLE 2.0 object and open PaintBrush to edit it.
  138. '____________________________________________________________________________
  139. Sub olePbrush_Click ()
  140.  
  141.     cmdEdit = True
  142.  
  143. End Sub
  144.  
  145. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  146. ' Update picture box if PaintBrush object data has changed.
  147. '____________________________________________________________________________
  148. Sub olePbrush_Updated (Code As Integer)
  149.  
  150.     If PictureStale And Code = OLE_CHANGED Then
  151.         Ole2Pic picBitmap, olePbrush
  152.         PictureStale = False         ' Prevent cascading Updated event
  153.     End If
  154.  
  155. End Sub
  156.  
  157. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  158. ' Edit the source bitmap.
  159. '____________________________________________________________________________
  160. Sub picBitmap_DblClick ()
  161.  
  162.     cmdEdit = True
  163.  
  164. End Sub
  165.  
  166. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  167. ' Draw the source bitmap on loading.
  168. '____________________________________________________________________________
  169. Sub picBitmap_Paint ()
  170. Static called
  171. Dim h, w, xc, xl, xr, yb, yc, yt
  172. Dim red As Long
  173. Const msg$ = "KLUDGE"
  174.  
  175.     If Not called Then    ' Paint just once to preserve edits
  176.         xl = 0
  177.         xr = picBitmap.ScaleWidth
  178.         xc = xr \ 2
  179.         yt = 0
  180.         yb = picBitmap.ScaleHeight
  181.         yc = yb \ 2
  182.         w = picBitmap.TextWidth(msg$)
  183.         h = picBitmap.TextHeight(msg$)
  184.         red = QBColor(4)
  185.         picBitmap.CurrentX = (xr - w) \ 2
  186.         picBitmap.CurrentY = (yb - h) \ 2
  187.         picBitmap.Print msg$
  188.         picBitmap.Circle (xc, yc), xc, red
  189.         picBitmap.Line (xr, yt)-(xl, yb), red
  190.         picBitmap.Refresh
  191.         called = True
  192.     End If
  193.         
  194. End Sub
  195.  
  196.